perm filename SUBST1.NEW[1,JRA] blob
sn#034720 filedate 1973-04-06 generic text, type T, neo UTF8
00100 (DE SUBST1(X Y Z)
00300 (PROG(VARNO VARL Z1 Z2)
00400 (SETQ VARNO 0)
00450 A(SETQ Z2(CNVT2(CAR Z)))(SUBST1A X Y Z2)
00500 (SETQ Z1(NCONC Z1(LIST Z2)))
00600 (SETQ Z(CDR Z))
00700 (COND(Z(GO A)))
00800 (RETURN Z1) ))
00900
01000 (DE SUBST1A(X Y Z)
01100 (PROG NIL
01200 A(COND((ATOM(CAR Z))(COND((EQ (CAR Z) Y)(RPLACA Z X))))
01300 ((CONST(CAR Z))(COND((EQUAL (CAR Z) Y)(RPLACA Z X))))
01400 ((EQUAL(CAR Z) Y)(RPLACA Z X))
01500 (T(SUBST1A X Y (CDAR Z))))
01600 (SETQ Z(CDR Z))
01700 (COND(Z(GO A)))
01800 ))